home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Tools & Apps / OS⁄Toolbox / MDEF (LS Pascal) / mdef main next >
Encoding:
Text File  |  1990-04-10  |  5.6 KB  |  168 lines  |  [TEXT/PJMM]
  1. unit mdef;
  2.  
  3. interface
  4.  
  5.     { A code resource must have no global variables.  All shared variables are }
  6.     { local procedure MAIN, and shared among its sub procedures }
  7.  
  8.     procedure Our_Custom_Menu (message: integer;
  9.                                     theMenu: MenuHandle;
  10.                                     var menuRect: Rect;
  11.                                     hitPt: Point;
  12.                                     var whichItem: integer);    { a code resource must have a procedure called MAIN }
  13.  
  14. implementation
  15.  
  16. {********************************************************************** }
  17. {                                                                       }
  18. {  entry point for our <M>enu <DEF>inition                              }
  19. {                                                                       }
  20. {  This menu displays patterns taken from the System PAT#.              }
  21. {  The size of the rectangles for each pattern are designated           }
  22. {  by PRECTWIDE and PRECTHIGH.  The menu is drawn with the              }
  23. {  rectangles, PATROWS high and PATCOLS wide, in this case,             }
  24. {  8 patterns high by 5 patterns wide.                                  }
  25. {  The MenuItem returned by the MDEF is the index within the            }
  26. {  PAT# of the pattern chosen by the user, and can be found with...     }
  27. {                                                                       }
  28. {     GetIndPattern(&somePatternVariable,LISTID,MenuItem);              }
  29. {                                                                       }
  30. {  From the LightspeedC "Project" menu:                                 }
  31. {                                                                       }
  32. {     "Set Project Type..."                                             }
  33. {     ---------------------------------------                           }
  34. {               Code Resource                                           }
  35. {     Type      MDEF                                                    }
  36. {     Id        130                                                     }
  37. {     Name      Pattern Menu [optional]                                 }
  38. {                                                                       }
  39. {     "Build Code Resource..."                                          }
  40. {     "MDEF Code" if you're using the "XFER MDEF" project to            }
  41. {     copy the MDEF and place it in the "patmenudemo.rsrc" file         }
  42. {********************************************************************** }
  43.  
  44.     procedure Our_Custom_Menu;
  45.  
  46.         const
  47.             PRECTWIDE = 32;        { how wide are the patterns    }
  48.             PRECTHIGH = 32;        { how high are the patterns }
  49.             PATROWS = 8;            { number of rows in menu }
  50.             PATCOLS = 5;            { number of columns in menu    }
  51.             LISTID = 1000;    { Resource ID of PAT# }
  52.  
  53.         procedure calcitemrect (MenuRect: Rect;
  54.                                         var resultRect: Rect;
  55.                                         item: integer);
  56.  
  57.             var
  58.                 row, col: integer;
  59.  
  60. { calculate the rectangle within the menu, (therefore, within MenuRect), }
  61. { for any given menu item designated by "item".  Find out which row and }
  62. { column the item is in, then construct the rectangle, and return the }
  63. { rectangle as the function result }
  64.  
  65.         begin
  66.             row := (item - 1) div PATCOLS;
  67.             col := (item - 1) mod PATCOLS;
  68.             resultRect.left := MenuRect.left + col * PRECTWIDE;
  69.             resultRect.top := MenuRect.top + row * PRECTHIGH;
  70.             resultRect.right := resultRect.left + PRECTWIDE;
  71.             resultRect.bottom := resultRect.top + PRECTHIGH;
  72.         end;
  73.  
  74.         procedure domenudraw (menuRect: Rect);
  75.  
  76.             var
  77.                 itemRect: Rect;
  78.                 thePat: Pattern;
  79.                 index: integer;
  80.  
  81. { cycle through PATROWS * PATCOLS items, getting a pattern from the }
  82. { System PAT#, and filling the menu rectangles with that pattern }
  83.  
  84.         begin
  85.             for index := 1 to (PATROWS * PATCOLS) do
  86.                 begin
  87.                     GetIndPattern(thePat, LISTID, index);    { get the pattern }
  88.                     calcitemrect(menuRect, itemRect, index);    { calculate the rectangle in the menu }
  89.                     InsetRect(itemRect, 1, 1);    { draw the menu item }
  90.                     FillRect(itemRect, thePat);
  91.                     FrameRect(itemRect);
  92.                 end;
  93.         end;
  94.  
  95.         procedure domenuchoose (menuRect: Rect;
  96.                                         hitPt: Point;
  97.                                         var whichItem: integer);
  98.  
  99.             var
  100.                 index, itemChosen: integer;
  101.                 testRect, oldRect: Rect;
  102.  
  103.         begin
  104.             itemChosen := 1000;
  105. { an impossible menu choice }
  106. { find out which menu item rectangle the mouse is in }
  107.             for index := 1 to PATROWS * PATCOLS do
  108.                 begin
  109.                     calcitemrect(menuRect, testRect, index);
  110.                     if PtInRect(hitPt, testRect) then
  111.                         begin
  112. { the mouse is in the "indexth" menu item }
  113.                             itemChosen := index;
  114.         {    break; }
  115.                         end;
  116.                 end;
  117.             if itemChosen <> 1000 then
  118.                 begin
  119. { then we found the mouse in a menu item. was there an old menu item selected? }
  120.                     if ((whichItem <> 0) and (whichItem <> itemChosen)) then
  121.                         begin
  122. { if so, then un-select it }
  123.                             calcitemrect(menuRect, oldRect, whichItem);
  124.                             PenMode(patXor);
  125.                             FrameRect(oldRect);
  126.                         end;
  127. { tell the menu manager which item was last selected and select it }
  128.                     whichItem := itemChosen;
  129.                     calcitemrect(menuRect, oldRect, itemChosen);
  130.                     PenMode(patCopy);
  131.                     FrameRect(oldRect);
  132.                 end
  133.             else if not PtInRect(hitPt, menuRect) then
  134. { no menu item was selected, so un-select any previous menu item selected }
  135.                 begin
  136.                     calcitemrect(menuRect, oldRect, whichItem);
  137.                     PenMode(patXor);
  138.                     FrameRect(oldRect);
  139.                     whichItem := 0;
  140.                 end;
  141.         end;
  142.  
  143.         procedure domenusize (var theMenu: Menuhandle);
  144.  
  145.         begin
  146. { tell the menu manager how large the menu rectangle is }
  147.             theMenu^^.menuWidth := PATCOLS * PRECTWIDE;
  148.             theMenu^^.menuHeight := PATROWS * PRECTHIGH;
  149.         end;
  150.  
  151.     begin
  152.     { what does the menu manager want us to do? }
  153.         case message of
  154.             mDrawMsg: 
  155.                 domenudraw(menuRect);
  156.  
  157.             mChooseMsg: 
  158.                 domenuchoose(menuRect, hitPt, whichItem);
  159.  
  160.             mSizeMsg: 
  161.                 domenusize(theMenu);
  162.  
  163.             otherwise
  164.                 ;
  165.         end;
  166.     end;
  167.  
  168. end.